home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / msdos / 4utils80.zip / 4DESC.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-17  |  30KB  |  897 lines
  1. PROGRAM FileDescEditor;
  2. {$A+,B-,D-,E-,F-,G+,L+,N-,O-,R+,S+,V-,X-}
  3. {$M 8192,0,655360}
  4.  
  5. (* ----------------------------------------------------------------------
  6.    A Simple 4DOS File Description Editor
  7.  
  8.    (c) 1992, 1993 Copyright by
  9.  
  10.        David Frey,         & Tom Bowden
  11.        Urdorferstrasse 30    1575 Canberra Drive
  12.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  13.        Switzerland           USA
  14.  
  15.        Code created using Turbo Pascal 7.0, (c) Borland International 1992
  16.  
  17.    DISCLAIMER: This program is freeware: you are allowed to use, copy
  18.                and change it free of charge, but you may not sell or hire
  19.                4DESC. The copyright remains in our hands.
  20.  
  21.                If you make any (considerable) changes to the source code,
  22.                please let us know. (send a copy or a listing).
  23.                We would like to see what you have done.
  24.  
  25.                We, David Frey and Tom Bowden, the authors, provide absolutely
  26.                no warranty of any kind. The user of this software takes the
  27.                entire risk of damages, failures, data losses or other
  28.                incidents.
  29.  
  30.    ----------------------------------------------------------------------- *)
  31.  
  32. USES {$IFOPT G+} Test286, {$ENDIF}
  33.      Fix, Crt, Dos, Memory,
  34.      StringDateHandling, DisplayKeyboardAndCursor, HandleINIFile,
  35.      DescriptionHandling, Dmouse;
  36.  
  37. CONST DelimiterTable : STRING = ',.();:-!?/[]{}+*=''`"@%&$_£';
  38.  
  39. VAR  EdStart     : BYTE;      (* column where the description starts     *)
  40.  
  41.      ActDir      : DirStr;    (* current directory                       *)
  42.      StartDir    : DirStr;    (* directory where we started from         *)
  43.  
  44.      StartIndex  : INTEGER;   (* index of entry at the top of the screen *)
  45.      Index       : INTEGER;   (* index of entry we are editing           *)
  46.  
  47.      CutPasteDesc: DescStr;   (* cut, resp. pasted description           *)
  48.      Changed     : BOOLEAN;   (* TRUE=the descriptions have been edited  *)
  49.      IORes       : INTEGER;
  50.  
  51.      NewDir      : DirStr;    (* temporary storage for a directory path, *)
  52.      NewName     : NameStr;   (* used by view and others                 *)
  53.      NewExt      : ExtStr;
  54.  
  55.      FirstParam  : STRING[2];
  56.      i           : BYTE;      (* variable for counting (index etc)       *)
  57.      ShowHelp    : BOOLEAN;   (* TRUE = start in help mode [/h]          *)
  58.      s           : STRING;    (* temporary string variable               *)
  59.  
  60. (*-------------------------------------------------------- Display-Routines *)
  61. PROCEDURE DisplayFileEntry(Index: INTEGER; x: BYTE; Hilighted: BOOLEAN);
  62. (* Displays the Index'th file entry. If the description is longer than
  63.    DispLen characters, DispLen characters - starting at character x of the
  64.    description - will be shown. (this feature is needed for scrolling).
  65.    Hilighted = TRUE will hilight the description.
  66.  
  67.    P.S. Scrolling implies hilighting, but this fact has not been exploited. *)
  68.  
  69.  VAR FileEntry : PFileData;
  70.      xs,y,l    : BYTE;
  71.  
  72.  BEGIN
  73.   y := 3+Index-StartIndex;
  74.   GotoXY(1,y);
  75.   IF (Index >= 0) AND (Index < FileList^.Count) THEN
  76.    BEGIN
  77.     FileEntry := NILCheck(FileList^.At(Index));
  78.  
  79.     IF Hilighted THEN
  80.      BEGIN TextColor(SelectFg); TextBackGround(SelectBg); END
  81.     ELSE
  82.      BEGIN
  83.       TextBackGround(NormBg);
  84.  
  85.       IF FileEntry^.GetSize <> DirSize THEN TextColor(NormFg)
  86.                                        ELSE TextColor(DirFg)
  87.      END;
  88.  
  89.     l := Length(FileEntry^.GetDesc);
  90.     IF x <= DispLen THEN xs := 1
  91.                     ELSE xs := x-DispLen+1;
  92.  
  93.     Write(FileEntry^.FormatScrollableDescription(xs,DispLen));
  94.  
  95.     IF l-xs < DispLen THEN
  96.      ClrEol
  97.     ELSE
  98.      BEGIN
  99.       TextColor(WarnFg); Write('»'); TextColor(NormFg);
  100.      END;
  101.  
  102.     IF x <= DispLen THEN GotoXY(EdStart+x-1,y)
  103.                     ELSE GotoXY(EdStart+DispLen-1,y)
  104.    END
  105.   ELSE ClrEol;
  106.  END;  (* DisplayFileEntry *)
  107.  
  108. PROCEDURE DrawDirLine;
  109. (* Draw the line, which tells us where in the directory tree we are. *)
  110.  
  111. BEGIN
  112.  GetDir(0,ActDir);
  113.  IF ActDir[Length(ActDir)] <> '\' THEN ActDir := ActDir + '\';
  114.  UpString(ActDir);
  115.  TextColor(DirFg); TextBackGround(NormBg);
  116.  GotoXY(1,2); Write(' ',ActDir); ClrEol;
  117. END; (* DrawDirLine *)
  118.  
  119. PROCEDURE ReDrawScreen;
  120. (* Redraws the full screen, needed after shelling out or after printing
  121.    the help screen.                                                     *)
  122.  
  123. VAR Index: INTEGER;
  124.  
  125. BEGIN
  126.  GetDir(0,ActDir);
  127.  FOR Index := StartIndex TO StartIndex+MaxLines-4 DO
  128.   DisplayFileEntry(Index,1,FALSE);
  129. END; (* ReDrawScreen *)
  130.  
  131.  
  132. (*-------------------------------------------------------- Read-Directory *)
  133. PROCEDURE ReadFiles;
  134. (* Scan the current directory and read in the DESCRIPT.ION file. Build a
  135.    file list database and associate the right description.
  136.  
  137.    Warn the user if there are too long descriptions or if there are too
  138.    much descriptions.                                                     *)
  139.  
  140. VAR i   : BYTE;
  141.     ch  : WORD;
  142.     Dir : PathStr;
  143.  
  144. BEGIN
  145.  Changed    := FALSE;
  146.  DescLong   := FALSE;
  147.  Index      := 0;
  148.  StartIndex := 0;
  149.  Dir := FExpand('.');
  150.  
  151.  IF FileList <> NIL THEN
  152.   BEGIN
  153.    Dispose(FileList,Done); FileList := NIL;
  154.   END;
  155.  
  156.  TextColor(StatusFg); TextBackGround(StatusBg);
  157.  GotoXY(1,MaxLines);
  158.  Write(Chars(' ',((ScreenWidth-40+Length(Dir)) DIV 2)),
  159.        'Scanning directory ',Dir,' .....  please wait.');
  160.  ClrEol;
  161.  
  162.  FileList := NIL; FileList := New(PFileList,Init(Dir));
  163.  IF FileList = NIL THEN Abort('Unable to allocate FileList');
  164.  
  165.  IF (FileList^.Status = ListTooManyFiles) OR
  166.     (FileList^.Status = ListOutofMem) THEN
  167.   BEGIN
  168.    TextColor(NormFg); TextBackGround(NormBg);
  169.    FOR i := 3 TO MaxLines-1 DO
  170.     BEGIN
  171.      GotoXY(1,i); ClrEol;
  172.     END;
  173.    IF FileList^.Status = ListTooManyFiles THEN
  174.     ReportError('Warning! Too many files in directory, description file will be truncated! (Key)',(CutPasteDesc <> ''),Changed)
  175.    ELSE
  176.     ReportError('Warning! Out of memory, description file will be truncated! (Key)',(CutPasteDesc <> ''),Changed);
  177.   END;
  178.  
  179.  IF FileList^.Count > 0 THEN
  180.   BEGIN
  181.    DrawMainScreen(Index,FileList^.Count);
  182.    DrawDirLine;
  183.   END;
  184.  
  185.  IF DescLong THEN
  186.   BEGIN
  187.    TextColor(NormFg); TextBackGround(NormBg);
  188.    FOR i := 3 TO MaxLines-1 DO
  189.     BEGIN
  190.      GotoXY(1,i); ClrEol;
  191.     END;
  192.    ReportError('Warning! Some descriptions are too long; they will be truncated. Press any key.',(CutPasteDesc <> ''),Changed);
  193.   END;
  194. END;  (* ReadFiles *)
  195.  
  196. (*-------------------------------------------------------- Save Descriptions *)
  197. PROCEDURE SaveDescriptions;
  198. (* Save the modified descriptions currently held in memory onto disk.
  199.    Rename the old description file into DESCRIPT.OLD and write the
  200.    new one out. Any problems occuring at this point (disk full etc),
  201.    raise a warning message and cause a deletion of the (half-written)
  202.    description file DESCRIPT.ION. In this case the user "only" looses his
  203.    new, edited descriptions, but the old ones are stored in the DESCRIPT.OLD
  204.    file and can be restored by typing
  205.  
  206.    REN DESCRIPT.OLD DESCRIPT.ION
  207.    ATTRIB +H DESCRIPT.ION                                                    *)
  208.  
  209. VAR DescFile  : TEXT;
  210.     DescSaved : BOOLEAN;
  211.     Time      : DateTime;
  212.     ch        : WORD;
  213.     FileEntry : PFileData;
  214.  
  215.  
  216.  PROCEDURE SaveEntry(FileEntry: PFileData); FAR;
  217.  (* Save a single description, writes a single line of the description
  218.     file. This procedures is called for each entry in the FileEntry list *)
  219.  
  220.  VAR Desc     : DescStr;
  221.      ProgInfo : STRING;
  222.      Dir      : DirStr;
  223.      BaseName : NameStr;
  224.      Ext      : ExtStr;
  225.  
  226.  BEGIN
  227.   Desc := FileEntry^.GetDesc;
  228.   StripLeadingSpaces(Desc); StripTrailingSpaces(Desc);
  229.   IF Desc <> '' THEN
  230.    BEGIN
  231.     FSplit(FileEntry^.GetName,Dir,Basename,Ext);
  232.     StripTrailingSpaces(BaseName);
  233.     Write(DescFile,BaseName);
  234.  
  235.     StripLeadingSpaces(Ext);
  236.     StripTrailingSpaces(Ext);
  237.     IF Ext <> '' THEN Write(DescFile,Ext);
  238.  
  239.     Write(DescFile,' ',Desc);
  240.     IF DescSaved = FALSE THEN DescSaved := TRUE;
  241.  
  242.     ProgInfo :=  FileEntry^.GetProgInfo;
  243.     IF ProgInfo <> '' THEN Write(DescFile,ProgInfo);
  244.     WriteLn(DescFile);
  245.    END;
  246.  END; (* SaveEntry *)
  247.  
  248. BEGIN
  249.  DescSaved := FALSE;
  250.  IF DiskFree(0) < FileList^.Count*SizeOf(TFileData) THEN
  251.    ReportError('Probably out of disk space. Nevertheless trying to save DESCRIPT.ION...',(CutPasteDesc <> ''),Changed);
  252.  TextColor(StatusFg); TextBackGround(StatusBg);
  253.  GotoXY(1,MaxLines);
  254.  Write(Chars(' ',((ScreenWidth-41) div 2)),
  255.        'Saving descriptions........  please wait.');
  256.  ClrEol;
  257.  
  258.  {$I-}
  259.  Assign(DescFile,'DESCRIPT.ION'); Rename(DescFile,'DESCRIPT.OLD'); IORes := IOResult;
  260.  Assign(DescFile,'DESCRIPT.ION'); SetFAttr(DescFile,Archive); IORes := IOResult;
  261.  Rewrite(DescFile);
  262.  {$I+}
  263.  IF IOResult > 0 THEN
  264.   BEGIN
  265.    ReportError('Unable to write DESCRIPT.ION !',(CutPasteDesc <> ''),Changed);
  266.    {$I-}
  267.    Assign(DescFile,'DESCRIPT.OLD'); Rename(DescFile,'DESCRIPT.ION'); IORes := IOResult;
  268.    {$I+}
  269.   END
  270.  ELSE
  271.   BEGIN
  272.    FileList^.ForEach(@SaveEntry);
  273.    {$I-}
  274.    Close(DescFile);
  275.    {$I+}
  276.  
  277.    IF IOResult > 0 THEN
  278.     BEGIN
  279.      ReportError('Unable to write DESCRIPT.ION !',(CutPasteDesc <> ''),Changed);
  280.      {$I-}
  281.      Assign(DescFile,'DESCRIPT.OLD'); Rename(DescFile,'DESCRIPT.ION'); IORes := IOResult;
  282.      {$I+}
  283.     END
  284.    ELSE
  285.     BEGIN
  286.      IF DescSaved THEN SetFAttr(DescFile, Archive + Hidden)
  287.                   ELSE Erase(DescFile);  (* Don't keep zero-byte file. *)
  288.      Changed := FALSE; DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
  289.      {$I-}
  290.      Assign(DescFile,'DESCRIPT.OLD'); Erase(DescFile); IORes := IOResult;
  291.      {$I+}
  292.     END;
  293.   END;
  294. END;  (* SaveDescriptions *)
  295.  
  296. (*-------------------------------------------------------- Edit Descriptions *)
  297. PROCEDURE EditDescriptions;
  298. (* This is the heart of 4DESC: the editing of the descriptions.
  299.  
  300.    The constants below are taken out from Turbo Pascal's help; any
  301.    completion is straight-forward. [ insert the appropriate key
  302.    definition in the constant section below and insert the associated
  303.    routine in the great CASE OF xxx branch below. ]                     *)
  304.  
  305. CONST kbLeft     = $4B00;   kbRight    = $4D00;
  306.       kbUp       = $4800;   kbDown     = $5000;
  307.       kbHome     = $4700;   kbEnd      = $4F00;
  308.       kbPgUp     = $4900;   kbPgDn     = $5100;
  309.       kbCtrlLeft = $7300;   kbCtrlRight= $7400;
  310.       kbCtrlPgDn = $7600;   kbCtrlPgUp = $8400;
  311.       kbCtrlHome = $7700;   kbCtrlEnd  = $7500;
  312.       kbEnter    = $0D;     kbEsc      = $1B;
  313.  
  314.       kbIns      = $5200;   kbDel      = $5300;
  315.       kbBack     = $08;
  316.  
  317.       kbGrayMinus= $4A2D;   kbGrayPlus = $4E2B;
  318.  
  319.       kbAltC     = $2E00;   kbAltP     = $1900;
  320.       kbAltD     = $2000;   kbAltL     = $2600;
  321.       kbAltM     = $3200;   kbAltT     = $1400;
  322.       kbAltS     = $1F00;   kbAltV     = $2F00;
  323.       kbAltX     = $2D00;
  324.  
  325.       kbF1       = $3B00;   kbF2       = $3C00;
  326.       kbF3       = $3D00;   kbF4       = $3E00;
  327.       kbF5       = $3F00;   kbF6       = $4000;
  328.       kbF10      = $4400;   kbShiftF10 = $5D00;
  329.  
  330. VAR Key          : WORD;
  331.     Drv          : STRING[3];
  332.     LastDrv      : CHAR;
  333.     x,y,l        : BYTE;
  334.     EditStr      : DescStr;
  335.     Overwrite    : BOOLEAN;
  336.     Cursor       : WORD;
  337.     OldDir       : DirStr;
  338.     ActFileData  : PFileData;
  339.     n            : NameExtStr;
  340.  
  341.  PROCEDURE UpdateLineNum(Index: INTEGER);
  342.  (* Update the line number indicator in the right corner and redraw
  343.     the associated description line                                 *)
  344.  
  345.  BEGIN
  346.   TextColor(StatusFg); TextBackGround(StatusBg);
  347.   GotoXY(66,1); Write(Index+1:5);
  348.  
  349.   IF Changed THEN DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  350.  
  351.   IF Index < FileList^.Count THEN
  352.    BEGIN
  353.     EditStr := PFileData(FileList^.At(Index))^.GetDesc;
  354.     DisplayFileEntry(Index,1,TRUE);
  355.    END;
  356.  
  357.   ActFileData := NILCheck(FileList^.At(Index));
  358.  END;
  359.  
  360.  PROCEDURE PrevIndex(VAR Index: INTEGER);
  361.  (* Go up one description line (if possible) *)
  362.  
  363.  BEGIN
  364.   Index := Max(Index-1,0);
  365.   IF Index <= StartIndex THEN
  366.    BEGIN
  367.     StartIndex := Max(Index-ScreenSize,0);
  368.     RedrawScreen;
  369.    END;
  370.   UpdateLineNum(Index);
  371.  END; (* PrevIndex *)
  372.  
  373.  PROCEDURE NextIndex(VAR Index: INTEGER);
  374.  (* Go down one description line (if possible) *)
  375.  
  376.  BEGIN
  377.   Index := Min(Index+1,FileList^.Count-1);
  378.   IF Index > StartIndex+ScreenSize THEN
  379.    BEGIN
  380.     StartIndex := Index-ScreenSize;
  381.     RedrawScreen;
  382.    END;
  383.   UpdateLineNum(Index);
  384.  END; (* NextIndex *)
  385.  
  386.  PROCEDURE QuerySaveDescriptions;
  387.  (* Ask the user if he really wants to save the descriptions. *)
  388.  
  389.  VAR ch: CHAR;
  390.  
  391.  BEGIN
  392.   TextColor(StatusFg); TextBackGround(StatusBg);
  393.   IF Changed THEN
  394.    BEGIN
  395.     GotoXY(1,MaxLines);
  396.     Write(Chars(' ',(ScreenWidth-58) div 2),
  397.          'Descriptions have been edited. Shall they be saved (Y/N) ?');
  398.     ClrEol;
  399.     ch := ' ';
  400.     REPEAT
  401.       If KeyPressed Then ch := UpCase(ReadKey)
  402.       Else
  403.         If MouseLoaded Then
  404.           Begin
  405.             ButtonReleased(Left);
  406.             If ReleaseCount > 0 Then ch := 'Y';
  407.             ButtonReleased(Right);
  408.             If ReleaseCount > 0 Then ch := 'N';
  409.           End;
  410.     UNTIL (ch = 'Y') OR (ch = 'N');
  411.     Write(' ',ch);
  412.     IF ch = 'Y' THEN SaveDescriptions;
  413.    END;
  414.  END; (* QuerySaveDescriptions *)
  415.  
  416.  PROCEDURE DirUp;
  417.  (* Go up one directory in the directory tree (if possible) *)
  418.  
  419.  BEGIN
  420.   IF Changed THEN QuerySaveDescriptions;
  421.   {$I-}
  422.   ChDir('..');
  423.   {$I+}
  424.   IF IOResult = 0 THEN
  425.    BEGIN
  426.     ReadFiles;
  427.     RedrawScreen;
  428.     DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  429.     Index := 0; UpdateLineNum(Index);
  430.    END;
  431.  END;  (* DirUp *)
  432.  
  433.  PROCEDURE DirDown;
  434.  (* Go down one directory in the directory tree (if possible) *)
  435.  
  436.  BEGIN
  437.   IF (Index < FileList^.Count) THEN
  438.    BEGIN
  439.     n  := ActFileData^.GetName;
  440.     IF (ActFileData^.GetSize = DirSize) AND (n[1] <> '.') THEN
  441.      BEGIN
  442.       IF Changed THEN QuerySaveDescriptions;
  443.       {$I-}
  444.       ChDir(n);
  445.       {$I+}
  446.       IF IOResult = 0 THEN
  447.        BEGIN
  448.         ReadFiles;
  449.         RedrawScreen;
  450.        END;
  451.       DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  452.       Index := 0; UpdateLineNum(Index);
  453.     END;  (* IF Description[Index].Size = DirSize *)
  454.    END;
  455.  END;  (* DirDown *)
  456.  
  457.  FUNCTION IsADelimiter(c: CHAR): BOOLEAN;
  458.  (* used by Ctrl-Left resp Ctrl-Right to recognize the end of a word *)
  459.  
  460.  BEGIN
  461.   IsADelimiter := (Pos(c,DelimiterTable) > 0);
  462.  END;
  463.  
  464. BEGIN  (* EditDescriptions *)
  465.  Index := 0; UpdateLineNum(Index);
  466.  
  467.  Overwrite := FALSE; ResetCursor(Overwrite);
  468.  EditStr := ActFileData^.GetDesc;
  469.  
  470.  REPEAT
  471.   REPEAT
  472.     Key := $0000;
  473.     IF KeyPressed THEN Key := GetKey
  474.     ELSE
  475.       BEGIN
  476.         IF MouseLoaded THEN
  477.           BEGIN
  478.             MouseMotion;
  479.             IF VMickey > VMickeysPerKeyPress THEN Key := kbDown
  480.             ELSE
  481.               IF VMickey < -VMickeysPerKeyPress THEN Key := kbUp
  482.               ELSE
  483.               IF HMickey >  HMickeysPerKeyPress THEN Key := kbRight
  484.               ELSE
  485.                 IF HMickey < -HMickeysPerKeyPress THEN Key := kbLeft
  486.                 ELSE
  487.                   BEGIN
  488.                     ButtonReleased(Left);
  489.                     IF ReleaseCount > 0 THEN Key := kbEnter;
  490.                     ButtonReleased(Right);
  491.                     IF ReleaseCount > 0 THEN Key := kbEsc;
  492.                   END;
  493.  
  494.           END;  (* if mouseloaded *)
  495.       END;
  496.   UNTIL Key <> $0000;
  497.  
  498.   CASE Key OF
  499.    kbUp       : BEGIN
  500.                  ActFileData^.AssignDesc(EditStr);
  501.                  x := 1;
  502.                  DisplayFileEntry(Index,x,FALSE); PrevIndex(Index);
  503.                 END; (* Up *)
  504.  
  505.    kbDown     : BEGIN
  506.                  ActFileData^.AssignDesc(EditStr);
  507.                  x := 1;
  508.                  DisplayFileEntry(Index,x,FALSE); NextIndex(Index);
  509.                 END; (* Down *)
  510.  
  511.    kbLeft     : BEGIN
  512.                  x := Max(1,x-1);
  513.                  DisplayFileEntry(Index,x,TRUE);
  514.                 END; (* Left *)
  515.  
  516.    kbRight    : BEGIN
  517.                  x := Min(1+x,Length(EditStr));
  518.                  DisplayFileEntry(Index,x,TRUE);
  519.                 END; (* Right *)
  520.  
  521.    kbCtrlLeft : BEGIN
  522.                  DEC(x);
  523.                  WHILE (x > 0) AND IsADelimiter(EditStr[x]) DO DEC(x);
  524.                  WHILE (x > 0) AND NOT IsADelimiter(EditStr[x]) DO DEC(x);
  525.                  INC(x);
  526.                  DisplayFileEntry(Index,x,TRUE);
  527.                 END; (* ^Left *)
  528.  
  529.    kbCtrlRight: BEGIN
  530.                  l := Length(EditStr);
  531.                  WHILE (x < l) AND NOT IsADelimiter(EditStr[x]) DO INC(x);
  532.                  WHILE (x < l) AND IsADelimiter(EditStr[x]) DO INC(x);
  533.                  IF x = l THEN INC(x);
  534.                  DisplayFileEntry(Index,x,TRUE);
  535.                 END; (*  ^Right *)
  536.  
  537.    kbHome     : BEGIN
  538.                  x := 1; DisplayFileEntry(Index,x,TRUE);
  539.                 END; (* Home *)
  540.  
  541.    kbEnd      : BEGIN
  542.                  x := Min(Length(EditStr)+1,MaxDescLen);
  543.                  DisplayFileEntry(Index,x,TRUE);
  544.                 END; (* End *)
  545.  
  546.    kbCtrlEnd  : BEGIN
  547.                  Delete(EditStr,x,MaxDescLen);
  548.                  ActFileData^.AssignDesc(EditStr);
  549.                  Changed := TRUE;
  550.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  551.                  DisplayFileEntry(Index,x,TRUE);
  552.                 END;  (* ^End *)
  553.  
  554.    kbIns      : BEGIN
  555.                  Overwrite := NOT Overwrite;
  556.                  ResetCursor(Overwrite);
  557.                 END; (* Ins *)
  558.  
  559.    kbDel      : BEGIN
  560.                  IF x <= Length(EditStr) THEN Delete(EditStr,x,1);
  561.                  ActFileData^.AssignDesc(EditStr);
  562.                  Changed := TRUE;
  563.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  564.                  DisplayFileEntry(Index,x,TRUE);
  565.                 END; (* Del *)
  566.  
  567.    kbBack     : BEGIN
  568.                  Delete(EditStr,x-1,1);
  569.                  ActFileData^.AssignDesc(EditStr);
  570.                  IF x > 1 THEN
  571.                   BEGIN
  572.                    DEC(x);
  573.                    IF x > Length(EditStr) THEN x := Length(EditStr)+1;
  574.                   END;
  575.                  DisplayFileEntry(Index,x,TRUE);
  576.                  Changed := TRUE;
  577.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  578.                  DisplayFileEntry(Index,x,TRUE);
  579.                 END; (* Backspace *)
  580.  
  581.    kbPgUp     : BEGIN
  582.                  ActFileData^.AssignDesc(EditStr);
  583.                  x := 1;
  584.                  DisplayFileEntry(Index,x,FALSE);
  585.                  Index := Max(Index-ScreenSize,0);
  586.                  StartIndex := Index;
  587.                  RedrawScreen;
  588.                  UpdateLineNum(Index);
  589.                 END; (* PgUp *)
  590.  
  591.    kbPgDn     : BEGIN
  592.                  ActFileData^.AssignDesc(EditStr);
  593.                  Index := Min(Index+ScreenSize,FileList^.Count-1);
  594.                  StartIndex := Max(Index-ScreenSize,0);
  595.                  x := 1;
  596.                  DisplayFileEntry(Index,x,FALSE);
  597.                  RedrawScreen;
  598.                  UpdateLineNum(Index);
  599.                 END; (* PgDn *)
  600.  
  601.    kbCtrlPgUp : BEGIN
  602.                  ActFileData^.AssignDesc(EditStr);
  603.                  x := 1;
  604.                  DisplayFileEntry(Index,x,FALSE);
  605.                  StartIndex := 0; Index := 0;
  606.                  RedrawScreen;
  607.                  UpdateLineNum(Index);
  608.                 END; (* ^PgUp *)
  609.  
  610.    kbCtrlPgDn : BEGIN
  611.                  ActFileData^.AssignDesc(EditStr);
  612.                  x := 1;
  613.                  DisplayFileEntry(Index,x,FALSE);
  614.                  StartIndex := Max(FileList^.Count-ScreenSize,0);
  615.                  Index := FileList^.Count-1;
  616.                  RedrawScreen;
  617.                  UpdateLineNum(Index);
  618.                 END; (* ^PgDn *)
  619.  
  620.    kbAltD     : BEGIN
  621.                  ActFileData^.AssignDesc('');
  622.                  Changed := TRUE;
  623.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  624.                  x := 1;
  625.                  DisplayFileEntry(Index,x,FALSE);
  626.                  NextIndex(Index);
  627.                 END; (* Alt-D *)
  628.  
  629.    kbAltM,
  630.    kbAltT     : BEGIN
  631.                  CutPasteDesc := ActFileData^.GetDesc;
  632.                  ActFileData^.AssignDesc(''); EditStr := '';
  633.                  Changed := TRUE;
  634.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  635.                  x := 1;
  636.                  DisplayFileEntry(Index,x,FALSE);
  637.                  NextIndex(Index);
  638.                 END; (* Alt-M / Alt-T *)
  639.  
  640.    kbAltC     : BEGIN
  641.                  CutPasteDesc := ActFileData^.GetDesc;
  642.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  643.                  x := 1;
  644.                  DisplayFileEntry(Index,x,TRUE);
  645.                 END; (* Alt-C *)
  646.  
  647.    kbAltP     : IF CutPasteDesc > '' THEN
  648.                  BEGIN
  649.                   ActFileData^.AssignDesc(CutPasteDesc);
  650.                   x := 1;
  651.                   DisplayFileEntry(Index,x,FALSE);
  652.                   Changed := TRUE;
  653.                   DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  654.                   NextIndex(Index);
  655.                  END; (* Alt-P *)
  656.  
  657.    kbEnter    : BEGIN
  658.                   ActFileData^.AssignDesc(EditStr);
  659.                   x := 1;
  660.                   DisplayFileEntry(Index,x,TRUE);
  661.                   IF (Index < FileList^.Count) THEN
  662.                     BEGIN
  663.                       n  := ActFileData^.GetName;
  664.                       IF (ActFileData^.GetSize = DirSize) THEN
  665.                         IF (n[1] = '.') AND (n[2] = '.') THEN DirUp
  666.                           ELSE
  667.                         IF n[1] <> '.' THEN DirDown;
  668.                     END;
  669.                 END; (* Enter = go into directory where the cursor is at *)
  670.  
  671.    kbF1       : BEGIN                                   (* F1: Help *)
  672.                  ShowHelpPage;
  673.                  ResetCursor(Overwrite);
  674.                  DrawMainScreen(Index,FileList^.Count);
  675.                  DrawDirLine;
  676.                  RedrawScreen;
  677.                  UpdateLineNum(Index);
  678.                 END;  (* F1 *)
  679.  
  680.    kbF4       : DirDown; (* F4 *)
  681.    kbF5       : DirUp;   (* F5 *)
  682.  
  683.    kbAltL,
  684.    kbF6       : BEGIN                                   (* F6: Change Drive *)
  685.                  IF Changed THEN QuerySaveDescriptions;
  686.  
  687.                  ASM
  688.                   mov ah,0eh       (* Select Disk *)
  689.                   mov dl,3
  690.                   int 21h
  691.                   add al,'@'
  692.                   mov LastDrv,al
  693.                  END;
  694.  
  695.                  IF LastDrv > 'Z' THEN LastDrv := 'Z';
  696.  
  697.                  TextColor(StatusFg); TextBackGround(StatusBg); Drv := ' :';
  698.                  GotoXY(1,MaxLines);
  699.                  Write(Chars(' ',((ScreenWidth-24) div 2)),
  700.                       'New drive letter (A..',LastDrv,'): ');
  701.                  ClrEol;
  702.                  REPEAT
  703.                   Drv[1] := UpCase(ReadKey);
  704.                  UNTIL (Drv[1] >= 'A') AND (Drv[1] <= LastDrv);
  705.                  IF Drv[1] <= 'B' THEN Drv := Drv + '\';
  706.                  OldDir := ActDir;
  707.                  {$I-}
  708.                  ChDir(Drv);
  709.                  {$I+}
  710.                  IF IOResult = 0 THEN
  711.                   BEGIN
  712.                    GetDir(0,ActDir); IORes := IOResult;
  713.                    ReadFiles;
  714.                    IF FileList^.Count = 0 THEN
  715.                     BEGIN
  716.                      IF (Length(OldDir) > 3) AND (OldDir[Length(OldDir)] = '\') THEN
  717.                         Delete(OldDir,Length(OldDir),1);
  718.                      {$I-}
  719.                      ChDir(OldDir); IORes := IOResult;
  720.                      {$I+}
  721.                      ReportError('There are no files on drive '+Drv+'. Press any key.',(CutPasteDesc <> ''),Changed);
  722.                      ReadFiles;
  723.                     END;
  724.                    RedrawScreen;
  725.                    DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);;
  726.                    Index := 0;
  727.                    UpdateLineNum(Index);
  728.                   END
  729.                  ELSE
  730.                   BEGIN
  731.                    ReportError('Drive '+Drv+' not ready! Drive remains unchanged, press a key.',(CutPasteDesc <> ''),Changed);
  732.                    {$I-}
  733.                    Chdir(OldDir); IORes := IOResult;
  734.                    {$I+}
  735.                   END;
  736.                 END;  (* Alt-L or F6 *)
  737.  
  738.    kbF10,
  739.    kbF2      : BEGIN                                   (* F10: Save *)
  740.                 SaveDescriptions;
  741.                 UpdateLineNum(Index);
  742.                END; (* F10 or F2 *)
  743.    kbAltS,
  744.    kbShiftF10: BEGIN                                   (* Shell to [4]DOS *)
  745.                 IF Changed THEN QuerySaveDescriptions;
  746.  
  747.                 DoneMemory;
  748.                 SetMemTop(HeapPtr);
  749.  
  750.                 NormVideo; ClrScr;
  751.                 WriteLn('Type `Exit'' to return to 4DESC.');
  752.                 SwapVectors;
  753.                 Exec(GetEnv('COMSPEC'),'');
  754.                 SwapVectors;
  755.  
  756.                 SetMemTop(HeapEnd);
  757.                 InitMemory;
  758.  
  759.                 IF MouseLoaded THEN MouseReset;
  760.  
  761.                 ClrScr;
  762.                 DrawMainScreen(Index,FileList^.Count);
  763.                 DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
  764.                 DrawDirLine;
  765.                 IF DosError > 0 THEN
  766.                   ReportError('Can''t load command interpreter / program execution failed.',
  767.                              (CutPasteDesc <> ''),Changed);;
  768.                 ReadFiles;
  769.                 RedrawScreen;
  770.                 UpdateLineNum(Index);
  771.                END; (* Alt-S or F10 *)
  772.    kbAltV,
  773.    kbF3      : IF (Index < FileList^.Count) THEN
  774.                 BEGIN
  775.                  IF ActFileData^.GetSize <> DirSize THEN
  776.                   BEGIN                                  (* F3: View File *)
  777.                    FSplit(ActFileData^.GetName,NewDir,NewName,NewExt);
  778.                    StripTrailingSpaces(NewName);
  779.                    NewDir := ActDir; (* I do not want to loose actdir, newdir
  780.                                         is only a "dummy" variable. *)
  781.                    IF (Length(NewDir) > 3) AND (NewDir[Length(NewDir)] = '\') THEN
  782.                     Delete(NewDir,Length(NewDir),1);
  783.  
  784.                    DoneMemory;
  785.                    SetMemTop(HeapPtr);
  786.  
  787.                    SwapVectors;
  788.                    Exec(GetEnv('COMSPEC'),'/c '+ListCmd+' '+NewDir+'\'+NewName+NewExt);
  789.                    SwapVectors;
  790.  
  791.                    SetMemTop(HeapEnd);
  792.                    InitMemory;
  793.  
  794.                    IF MouseLoaded THEN MouseReset;
  795.  
  796.                    ClrScr;
  797.                    DrawMainScreen(Index,FileList^.Count);
  798.                    DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
  799.                    DrawDirLine;
  800.                    IF DosError > 0 THEN ReportError('Can''t load command interpreter/program execution failed.',
  801.                                                    (CutPasteDesc <> ''),Changed);
  802.                    RedrawScreen;
  803.                    UpdateLineNum(Index);
  804.                  END;
  805.                 END; (* Alt-V or F3 *)
  806.   ELSE
  807.    IF (Ord(Key) > 31) AND (Ord(Key) < 256) THEN
  808.     BEGIN
  809.      IF NOT Changed THEN
  810.       BEGIN
  811.        Changed := TRUE;
  812.        DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  813.       END;
  814.  
  815.      IF x <= MaxDescLen THEN
  816.       BEGIN
  817.        IF Overwrite AND (x <= Length(EditStr)) THEN
  818.          EditStr[x] := Chr(Key)
  819.        ELSE
  820.          EditStr := Copy(EditStr,1,x-1)+Chr(Key)+Copy(EditStr,x,255);
  821.  
  822.        ActFileData^.AssignDesc(EditStr);
  823.        INC(x);
  824.       END;
  825.  
  826.      DisplayFileEntry(Index,x,TRUE);
  827.     END; (* all others *)
  828.   END;   (* case *)
  829.  
  830.  UNTIL (Key = kbEsc) OR (Key = kbAltX); (* ESC or AltX quits *)
  831.  
  832.  IF Changed THEN QuerySaveDescriptions;
  833. END; (* EditDescriptions *)
  834.  
  835. (*-------------------------------------------------------- Main *)
  836. BEGIN
  837.  EdStart := 25+Length(DateFormat)+Length(TimeFormat);
  838.  DispLen := ScreenWidth-EdStart;
  839.  Str(DispLen,s); Template:= ' %-12s%s %s %s %-'+s+'s';
  840.  (* Template used by FormatDescription *)
  841.  
  842.  {$I-}
  843.  GetDir(0,StartDir); IORes := IOResult; ShowHelp := FALSE;
  844.  {$I+}
  845.  IF ParamCount > 0 THEN
  846.   BEGIN
  847.    FOR i := 1 TO Min(2,ParamCount) DO
  848.     BEGIN
  849.      FirstParam := ParamStr(i);
  850.      IF (FirstParam[1] = '/') OR (FirstParam[1] = '-') THEN
  851.       BEGIN
  852.        IF NOT Monochrome THEN Monochrome := (UpCase(FirstParam[2]) = 'M');
  853.        IF NOT ShowHelp THEN ShowHelp := (UpCase(FirstParam[2]) = 'H') OR
  854.                                             (FirstParam[2] = '?');
  855.       END;
  856.     END;  (* for ... do begin *)
  857.    NewDir := UpStr(ParamStr(ParamCount));
  858.    IF (NewDir[1] <> '/') AND (NewDir[1] <> '-') THEN
  859.     BEGIN
  860.     {$I-}
  861.     ChDir(NewDir); IORes := IOResult;
  862.     {$I+}
  863.     END;
  864.   END;  (* if paramcount > 0 *)
  865.  Changed := FALSE; CutPasteDesc := '';
  866.  ChooseColors(Monochrome);
  867.  DrawMainScreen(0,0);
  868.  IF INIFileExists THEN
  869.   DelimiterTable := ReadSettingsString('misc','delimiters',DelimiterTable);
  870.  DelimiterTable := ' '+DelimiterTable;
  871.  
  872.  IF ShowHelp THEN ShowHelpPage;
  873.  IF IORes > 0 THEN
  874.   ReportError(NewDir+' not found. Directory remains unchanged.',FALSE,FALSE);
  875.  
  876.  InitMemory;
  877.  ReadFiles;
  878.  RedrawScreen;
  879.  EditDescriptions;
  880.  Dispose(FileList,Done); FileList := NIL;
  881.  DoneMemory;
  882.  
  883.  {$I-}
  884.  ChDir(StartDir); IORes := IOResult;
  885.  {$I+}
  886.  
  887.  IF MouseLoaded THEN MouseReset;
  888.  SetCursorShape(OrigCursor);
  889.  NormVideo;
  890.  ClrScr;
  891.  WriteLn(Header1);
  892.  WriteLn(Header2);
  893.  WriteLn;
  894.  WriteLn('This program is freeware: you are allowed to use, copy it free');
  895.  WriteLn('of charge, but you may not sell or hire 4DESC.');
  896. END.
  897.